home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / uimagine / imgdemo.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  7KB  |  207 lines
  1. {****************************************************************************}
  2. { This unit demonstrates the use of imagine.dll as an image viewer
  3. {****************************************************************************}
  4.  
  5. unit Imgdemo;
  6.  
  7.  
  8. interface
  9.  
  10.  
  11. uses
  12.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Image,
  13.   Controls, Forms, Dialogs, MMSystem, Menus, ExtCtrls, StdCtrls;
  14.  
  15. type
  16.   TForm1 = class(TForm)
  17.     OpenDialog1: TOpenDialog;
  18.     MainMenu1: TMainMenu;
  19.     File1: TMenuItem;
  20.     Open1: TMenuItem;
  21.     Save1: TMenuItem;
  22.     Sep1: TMenuItem;
  23.     Panel1: TPanel;
  24.     SaveDialog1: TSaveDialog;
  25.     ScrollBox1: TScrollBox;
  26.     Image1: TImage;
  27.     Exit1: TMenuItem;
  28.     Reduce1: TMenuItem;
  29.     Reduce2: TMenuItem;
  30.     Sep2: TMenuItem;
  31.     procedure Open1Click(Sender: TObject);
  32.     procedure Exit1Click(Sender: TObject);
  33.     procedure Save1Click(Sender: TObject);
  34.     procedure File1Click(Sender: TObject);
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure Reduce1Click(Sender: TObject);
  37.     procedure Reduce2Click(Sender: TObject);
  38.   private
  39.     { Private declarations }
  40.   public
  41.     { Public declarations }
  42.   end;
  43.  
  44. var
  45.   bmp:TBitmap;                   { bitmap class derived from TBitmap }
  46.   Form1: TForm1;
  47.   sIn: String;
  48.   Procedure CallBack(i : Integer); export;
  49.  
  50.  
  51. implementation
  52. {$R *.DFM}
  53.  
  54.  
  55. {****************************************************************************}
  56. procedure TForm1.Open1Click(Sender: TObject);
  57. { Main procedure - handles 3 situations
  58.   1. If the image is an icon or metafile, Delphi will load it.
  59.   2. If the image is a bitmap, Delphi will load it unless it's true color & the
  60.      user wants color reduction.
  61.   3. If the image is a .gif, .mac, .jpg, .pcx, .tga, or .wpg, it will be
  62.      converted to a bitmap, then loaded.                                     }
  63. {****************************************************************************}
  64. var
  65.   output, reduce: Integer;
  66.   s, sExt: String;
  67. begin
  68.   bmp := TBitmap.Create;         { create a bitmap structure }
  69.   If OpenDialog1.Execute Then    { load open file dialog }
  70.     begin
  71.     sIn := OpenDialog1.FileName;
  72.     sExt := AnsiUpperCase(ExtractFileExt(sIn));
  73.  
  74.     reduce := 0;
  75.     if Reduce1.Checked = True then reduce := 1;
  76.     if Reduce2.Checked = True then reduce := 2;
  77.  
  78.     if (sExt = '.ICO') or (sExt = '.WMF') then
  79.       begin                      { let Delphi load it }
  80.         Image1.Picture.LoadFromFile(sIn);
  81.       end
  82.     else
  83.       begin                      { make sure we write to a hard drive }
  84.       s := GetTempDrive('a') + ':\tmp.bmp';
  85.       output := ConvertImage(Callback, reduce, sIn, s);
  86.       if output = 0 then         { 0 indicates success }
  87.         begin
  88.         bmp.LoadFromFile(s);
  89.         Image1.Picture.Bitmap := bmp;
  90.         end
  91.       else if output = 11 then   { let Delphi load it }
  92.         begin
  93.         Image1.Picture.LoadFromFile(sIn);
  94.         end
  95.       else                       { failed - display error message }
  96.         MessageDlg(ReturnError(output), mtError, [mbOk], 0);
  97.       DeleteFile(s);             { delete temporary file }
  98.       end;
  99.     end;
  100.  
  101.   bmp.free;
  102. end;
  103.  
  104.  
  105. {****************************************************************************}
  106. Procedure CallBack(i : Integer);
  107. { This procedure receives messages from imagine.dll at 25% intervals.
  108.   Since the dll expects to see this procedure, it must be present somewhere
  109.   in your code.  You may, of course, have it do nothing if desired.          }
  110. {****************************************************************************}
  111. var
  112.   s: String;
  113.   j: Integer;
  114. begin
  115.   Application.ProcessMessages;
  116.   If i = 0 then Form1.Panel1.Caption := '';
  117.   If j <> i then
  118.     begin
  119.       If i = 25 then Form1.Panel1.Caption := ' Reading image...';
  120.       If i = 50 then Form1.Panel1.Caption := ' Decompressing image...';
  121.       If i = 75 then Form1.Panel1.Caption := ' Writing bitmap...';
  122.       If i = 100 then Form1.Panel1.Caption := ' Processing complete.';
  123.     end;
  124.   j := i;
  125. end;
  126.  
  127.  
  128. {****************************************************************************}
  129. procedure TForm1.Save1Click(Sender: TObject);
  130. { Saves image to file.  Note that if color reduction was made, Delphi will
  131.   save image as a 256 color bitmap.                                          }
  132. {****************************************************************************}
  133. var
  134.   sOut: String;
  135. begin
  136.   If SaveDialog1.Execute Then
  137.   begin
  138.     sOut := SaveDialog1.FileName;
  139.     Image1.Picture.SaveToFile(sOut);
  140.     Form1.Panel1.Caption := ' ' + AnsiLowerCase(sOut) + ' saved.';
  141.   end;
  142. end;
  143.  
  144.  
  145. {****************************************************************************}
  146. procedure TForm1.File1Click(Sender: TObject);
  147. {****************************************************************************}
  148. begin
  149.   If Length(sIn) > 1 then
  150.     Save1.Enabled := True
  151.   else
  152.     Save1.Enabled := False;
  153. end;
  154.  
  155.  
  156. {****************************************************************************}
  157. procedure TForm1.Exit1Click(Sender: TObject);
  158. {****************************************************************************}
  159. begin
  160.   Close;
  161. end;
  162.  
  163.  
  164. {****************************************************************************}
  165. procedure TForm1.FormCreate(Sender: TObject);
  166. {****************************************************************************}
  167. var
  168.   DC: hDC;
  169.   BPP: byte;
  170. begin                            { if user isn't running true color, }
  171.   DC:=GetDC(0);                  { set up color reduction. }
  172.   BPP:=GetDeviceCaps(DC, BITSPIXEL);
  173.   ReleaseDC(0, DC);
  174.   if (BPP <= 8) then Reduce1.Checked := True;
  175. end;
  176.  
  177.  
  178. {****************************************************************************}
  179. procedure TForm1.Reduce1Click(Sender: TObject);
  180. {****************************************************************************}
  181. begin
  182.   If Reduce1.Checked = False then
  183.     begin
  184.     Reduce2.Checked := False;
  185.     Reduce1.Checked := True;     { color reduction is requested. }
  186.     end
  187.   Else
  188.     Reduce1.Checked := False;
  189. end;
  190.  
  191.  
  192. {****************************************************************************}
  193. procedure TForm1.Reduce2Click(Sender: TObject);
  194. {****************************************************************************}
  195. begin
  196.   If Reduce2.Checked = False then
  197.     begin
  198.     Reduce1.Checked := False;
  199.     Reduce2.Checked := True;     { reduce colors w/ high quality JPEG output. }
  200.     end
  201.   Else
  202.     Reduce2.Checked := False;
  203. end;
  204.  
  205. end.
  206.  
  207.